home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / modprolg / mod-prol.lha / Prolog / sim / load_work.c < prev    next >
C/C++ Source or Header  |  1992-05-01  |  12KB  |  403 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25. /****************************************************************************
  26.  *                                                                          *
  27.  * This file has been changed by to include Modules Extensions              *
  28.  * Changes by : Brian Paxton 1991/92                                        *
  29.  * December 1991                                                            *
  30.  *                                                                          *
  31.  * Organisation : University of Edinburgh.                                  *
  32.  * For : Departments of Computer Science and Artificial Intelligence        * 
  33.  *       Fourth Year Project.                                               *
  34.  *                                                                          *
  35.  ****************************************************************************/
  36.  
  37. /* load_work.c */
  38.  
  39. #define DEBUG_OVERFLOW
  40. /*
  41. #define DEBUG_NAMESTRING
  42. #define DEBUG_LOADWORK
  43. */
  44.  
  45. #include "sim.h"
  46. #include "aux.h"
  47. /* #include <stdio,h> */
  48. #define ALIGN(type,ptr)  ptr = (type)(((LONG)ptr + 3) & 0xfffffffc)
  49.  
  50. /************************************************************************
  51. *                                                                       *
  52. *  The hash function uses the arity and character string associated     *
  53. *  with a predicate, constant, or structure to find the proper bucket   *
  54. *  (a bucket is a linked list within the pcs table) to insert or locate *
  55. *  pcs entries.                                                         *
  56. *                                                                       *
  57. ************************************************************************/
  58.  
  59. int hash(name, length, arity)  /* hashing function on name,returning a */
  60. CHAR_PTR name;                 /* bucket number in the hash table      */
  61. WORD     length;
  62. BYTE     arity;
  63. {
  64.    int bucknum;
  65.  
  66.    bucknum = arity + 1;
  67.    if (length > 0) {              /* first */
  68.       bucknum = bucknum + *name;
  69.       if (length > 1) {           /* last */
  70.          bucknum = (bucknum << 2) + *(name + length - 1);
  71.          if (length > 2) {        /* middle */
  72.             bucknum = (bucknum << 2) + *(name + length / 2);
  73.             if (length > 3)
  74.                bucknum = (bucknum << 2) + *(name+(length / 2) - 1);
  75.          }
  76.       }
  77.    }
  78.    return abs(bucknum % BUCKET_CHAIN);
  79.  
  80. }  /* end of hash */
  81.  
  82. /******************************************************************************/
  83.  
  84. LONG_PTR search(name, length, arity, hash_ptr)
  85. CHAR_PTR name;
  86. BYTE     arity;
  87. WORD     length;
  88. LONG_PTR hash_ptr;
  89. {
  90.    PSC_REC_PTR psc_ptr;
  91.    unsigned short i;
  92.    struct booleans {
  93.       unsigned eq   : 1;
  94.       unsigned stop : 1;
  95.    } flag;
  96.  
  97.    flag.eq   = FALSE;
  98.    flag.stop = FALSE;
  99.  
  100. #ifdef  DEBUG_LOADWORK
  101.    printf("search: name = %s   len = %d   arity = %d  ", name, length, arity);
  102.    printf("hash = %08x\n", hash_ptr);
  103. #endif
  104.  
  105.    while (!ISFREE(hash_ptr) && flag.stop == FALSE) {
  106.       hash_ptr = (LONG_PTR)FOLLOW(hash_ptr);    /* pointer to pair */
  107.       psc_ptr = (PSC_REC_PTR)FOLLOW(hash_ptr);  /* pointer to psc record */
  108.  
  109. #ifdef  DEBUG_LOADWORK
  110.       printf("   hash_ptr  %08x   psc_ptr  %08x     *hash_ptr  %08x  \n",
  111.              hash_ptr, psc_ptr, *hash_ptr);
  112. #endif
  113.  
  114.       if (arity  == GET_ARITY(psc_ptr) && length == GET_LENGTH(psc_ptr)) {
  115.          flag.eq = TRUE;
  116.          for (i = 0; i < length && flag.eq == TRUE; i++)
  117.             if (*(name + i) != *(GET_NAME(psc_ptr) + i))
  118.                flag.eq = FALSE;
  119.       }
  120.       if (flag.eq == TRUE)
  121.      flag.stop = TRUE;
  122.       else hash_ptr++;
  123.   }
  124.  
  125.   return hash_ptr;
  126.  
  127. }  /* end of search */
  128.  
  129. /******************************************************************************/
  130.  
  131. LONG_PTR insert_temp(name, length, hash_ptr)
  132. CHAR_PTR name;
  133. WORD     length;
  134. LONG_PTR hash_ptr;
  135. {
  136.    PSC_REC_PTR       psc_ptr;
  137.    LONG_PTR          new_pair, stack_top, heap_top;
  138.    register CHAR_PTR threg;
  139.    LONG              i;
  140.  
  141.    /* check for heap overflow */
  142.    stack_top = (breg < ereg) ? breg : ereg - ENV_SIZE(cpreg);
  143.    heap_top  = hreg + 4 + ((length + 3) >> 2);
  144.    if (stack_top < heap_top) {
  145.       /* garbage_collection("insert_temp"); */
  146.       if (stack_top < heap_top)    /* still too full */
  147.          quit("Heap overflow\n");
  148.    }
  149.    new_pair = hreg++;
  150.    FOLLOW(hash_ptr) = (LONG)new_pair;
  151.    PUSHTRAIL((LONG)hash_ptr);         /* trail for backtracking */
  152.    MAKE_FREE(LONG, *hreg);            /* 2nd of pair free */
  153.    FOLLOW(new_pair) = (LONG)++hreg;   /* 1st of pair points to psc_rec */
  154.    psc_ptr= (PSC_REC_PTR)hreg;        /* psc_ptr points to the psc entry */
  155.    hreg += 2;                         /* reserve the space on the heap */
  156.                                       /*   NO EP FIELD */
  157.  
  158.    /* make nameptr point to next available space on heap */
  159.  
  160.    GET_ETYPE(psc_ptr)  = T_ORDI;
  161.    GET_ARITY(psc_ptr)  = 0;
  162.    GET_LENGTH(psc_ptr) = length;
  163.   /* GET_NAME(psc_ptr) = name; */
  164.  
  165.    threg = (CHAR_PTR)hreg;
  166.    GET_NAME(psc_ptr) = threg;     /* copy name, since might write over it !! */
  167.    for (i = 0; i < length; i++)
  168.       *threg++ = *name++;
  169.  
  170.    hreg = (LONG_PTR)threg;
  171.    ALIGN(LONG_PTR, hreg);
  172.  
  173.    return new_pair;
  174.  
  175. }  /* end of insert_temp */
  176.  
  177. /******************************************************************************/
  178.  
  179. LONG_PTR insert_perm(name, length, arity, hash_ptr)
  180. CHAR_PTR name;
  181. BYTE     arity;
  182. WORD     length;
  183. LONG_PTR hash_ptr;
  184. {
  185.    PSC_REC_PTR   psc_ptr;
  186.    LONG_PTR      new_pair;
  187.    register LONG i;
  188.  
  189.    ALIGN(CHAR_PTR, curr_fence);
  190.  
  191.    new_pair = (LONG_PTR)curr_fence;
  192.    FOLLOW(hash_ptr) = (LONG)new_pair;           /* prev link to here */
  193.    curr_fence += 4;                             /* point to 2nd of pair */
  194.    MAKE_FREE(LONG_PTR,*(LONG_PTR *)curr_fence); /* set 2nd free */
  195.  
  196. #ifdef DEBUG_LOADWORK
  197.    printf("insert_perm %8x %8x\n", curr_fence, *(LONG_PTR)curr_fence);
  198. #endif
  199.  
  200.    curr_fence += 4;                             /* where we'll put psc_rec */
  201.    FOLLOW(new_pair) = (LONG)curr_fence;         /* set 1st to pt to psc_rec */
  202.    psc_ptr= (PSC_REC_PTR)curr_fence;            /* psc_ptr points there too */
  203.    curr_fence += 12;                            /* 12 bytes for psc_rec */
  204.  
  205.    GET_ETYPE(psc_ptr)  = T_ORDI;
  206.    GET_ARITY(psc_ptr)  = arity;
  207.    GET_LENGTH(psc_ptr) = length;
  208.    GET_NAME(psc_ptr)   = curr_fence;
  209.  
  210.    for (i = 0; i < length; i++)
  211.       *curr_fence++ = *name++;
  212.  
  213.    ALIGN(CHAR_PTR, curr_fence);
  214.  
  215.    if (curr_fence >= max_fence) {
  216. #ifdef DEBUG_OVERFLOW
  217.       printf("Overflow in \"insert_perm\" curr_fence = %08x max_fence = %08x\n",
  218.              curr_fence, max_fence);
  219. #endif
  220.       quit("Program area overflow\n");
  221.    }
  222.  
  223.    return new_pair;
  224.  
  225. }  /*  end of insert_perm */
  226.  
  227. /******************************************************************************/
  228.  
  229. LONG_PTR insert(name, length, arity, perm)
  230. CHAR_PTR name;
  231. WORD     length;
  232. BYTE     arity;
  233. BYTE_PTR perm;
  234. {
  235.    int      bucket_no;
  236.    LONG_PTR temp_ptr, perm_ptr, perm_hashptr, temp_hashptr, ret_ptr;
  237.  
  238.    bucket_no = hash(name, length, arity);
  239.    perm_hashptr = (LONG_PTR)&hash_table[bucket_no][PERM];
  240.  
  241. #ifdef DEBUG_LOADWORK
  242.    printf("insert: name = %s   len = %d   arity = %d  ", name, length, arity);
  243.    printf("bucket = %d  perm = %08x  hash = %08x\n",
  244.       bucket_no, perm_hashptr, *perm_hashptr);
  245. #endif
  246.  
  247.    perm_ptr = search(name, length, arity, perm_hashptr);
  248.    if (!ISFREE(perm_ptr)) {   /* found perm psc record */
  249.       if (!(*perm))
  250.          *perm = PERM;        /* set perm flag parameter */
  251.       return perm_ptr;        /* return permanent */
  252.    }
  253.  
  254.    temp_hashptr = (LONG_PTR)&hash_table[bucket_no][TEMP];  /* look for temp */
  255.    temp_ptr = search(name, length, arity, temp_hashptr);
  256.    if (!ISFREE(temp_ptr)) {  /* found temp psc record */
  257.       if (!(*perm))          /* temporary wanted */
  258.          return temp_ptr;    /* return ptr to psc record */
  259.       else {                 /* Perm wanted - convert temp to perm */
  260.          /*printf("cvting temp to perm: %c %d %d\n", *name, length, arity);*/
  261.          perm_ptr = insert_perm(name, length, arity, perm_ptr);
  262.          FOLLOW(temp_ptr) = FOLLOW(perm_ptr);
  263.          return perm_ptr;
  264.       }
  265.     } else {                 /* Insert constant where indicated */
  266.       if (*perm)
  267.          return insert_perm(name, length, arity, perm_ptr);
  268.       else
  269.          return insert_temp(name, length, temp_ptr);
  270.    }
  271. }  /* end of insert */
  272.  
  273. /************************************?????????????????????*********/
  274.  
  275. set_temp_ep(psc_ptr, ep)
  276. PSC_REC_PTR psc_ptr;
  277. {
  278.    if (ep >= 0) {
  279.       GET_ETYPE(psc_ptr) = T_TEMP_PRED;
  280.       GET_EP(psc_ptr) = (LONG_PTR)ep;
  281.    }
  282. }
  283.  
  284. /************************************?????????????????????*********/
  285.  
  286. set_real_ep(psc_ptr, base)
  287. PSC_REC_PTR psc_ptr;
  288. CHAR_PTR    base;
  289. {
  290.    if (GET_ETYPE(psc_ptr) == T_TEMP_PRED) {
  291.       GET_EP(psc_ptr) = (LONG_PTR)(base + (int)GET_EP(psc_ptr));  /*???*/
  292.       GET_ETYPE(psc_ptr) = T_PRED;
  293.    }
  294. }
  295.  
  296. /************************************?????????????????????*********/
  297.  
  298. /*
  299. set_file_ptr(psc_ptr, file_ptr)
  300. PSC_REC_PTR psc_ptr;
  301. FILE        *file_ptr;
  302. {
  303.    GET_ETYPE(psc_ptr) = T_FILE;
  304.    GET_EP(psc_ptr) = (WORD_PTR)(file_ptr);
  305. }
  306. */
  307.  
  308. /************************************?????????????????????*********/
  309.  
  310. /*
  311. unset_file_ptr(psc_ptr)
  312. PSC_REC_PTR psc_ptr;
  313. {
  314.    GET_ETYPE(psc_ptr) = T_ORDI;
  315.    GET_EP(psc_ptr) = 0;
  316. }
  317. */
  318.  
  319. /************************************?????????????????????*********/
  320.  
  321. namestring(psc_ptr, s)
  322. PSC_REC_PTR psc_ptr;
  323. CHAR_PTR    s;
  324. {
  325.    LONG     i, len;
  326.    CHAR_PTR st;
  327.  
  328.    len = GET_LENGTH(psc_ptr);
  329.    st  = GET_NAME(psc_ptr);
  330.  
  331. #ifdef DEBUG_NAMESTRING
  332.    printf("namestring: len = %d    string = %s\n", len, st);
  333. #endif
  334.    for (i = 0; i < len; i++)
  335.       *s++ = *st++;
  336.    *s = '\0';
  337. }
  338.  
  339. /************************************?????????????????????*********/
  340.  
  341. /* Added by Brian Paxton to strip off structure tags from filenames */
  342.  
  343. namestring2(psc_ptr, s)
  344. PSC_REC_PTR psc_ptr;
  345. CHAR_PTR    s;
  346. {
  347.    LONG     i,j, len;
  348.    CHAR_PTR st2, st;
  349.  
  350.    len = GET_LENGTH(psc_ptr);
  351.    st  = GET_NAME(psc_ptr);
  352.  
  353.    i = 0;
  354.    st2 = st;
  355.    while(i < len && (*st != '_' || *(st+1) != '_'))
  356.       {
  357.     *st++;
  358.     i++;
  359.       }
  360.  
  361.    if (i == len)
  362.      {
  363.        st = st2;
  364.        i = 0;
  365.      }
  366.    else
  367.      st += 2;
  368.  
  369.    for (j = i; j < len; j++)
  370.      *s++ = *st++;
  371.  
  372.    *s = '\0';
  373. }
  374.  
  375. /************************************?????????????????????*********/
  376.  
  377. LONG alloc_perm(size)   /* size should be a multiple of 4 */
  378. LONG size;
  379. {
  380.    LONG        addr;
  381.    PSC_REC_PTR psc_ptr;
  382.  
  383.    ALIGN(CHAR_PTR, curr_fence);
  384.    addr = (LONG)curr_fence;
  385.    psc_ptr = (PSC_REC_PTR)(curr_fence + 4);
  386.    *(LONG_PTR)curr_fence = (LONG)psc_ptr;  /* pt to psc record being created */
  387.    curr_fence += 12;                       /* no ep */
  388.    GET_ETYPE(psc_ptr)  = T_BUFF;
  389.    GET_ARITY(psc_ptr)  = 0;
  390.    GET_LENGTH(psc_ptr) = size;
  391.    GET_NAME(psc_ptr)   = curr_fence;
  392.    curr_fence += size;
  393.    ALIGN(CHAR_PTR, curr_fence);
  394.    if (curr_fence >= max_fence) {
  395. #ifdef DEBUG_OVERFLOW
  396.       printf("Overflow in \"alloc_perm\" curr_fence = %08x max_fence = %08x\n",
  397.              curr_fence, max_fence);
  398. #endif
  399.       quit("Program area overflow\n");
  400.    }
  401.    return addr;
  402. }  /* end of alloc_perm */
  403.